home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2008 February / PCWFEB08.iso / Software / Resources / Business / PaperCut Quota 6.3 / pc-setup(1).exe / {app} / create-virtual-dir.vbs < prev    next >
Encoding:
Text File  |  2006-01-11  |  5.8 KB  |  202 lines
  1. Option Explicit
  2.  
  3. On Error Resume Next
  4.  
  5.  
  6. Dim oArgs
  7. Set oArgs = WScript.Arguments
  8. If oArgs.Count <> 2 Then
  9.     ErrorExit "Require the 'virtual-dir-name' and 'path' parameters"
  10. End If
  11.  
  12. Dim sComputer, sVirtualDir, sPath
  13. sComputer = "localhost"
  14. sVirtualDir = oArgs(0)
  15. sPath = oArgs(1)
  16.  
  17. 'A quick check to set our language
  18. Dim WshShell
  19. Dim sLanguage
  20. sLanguage = "eng"
  21. Set WshShell = WScript.CreateObject("WScript.Shell")
  22. sLanguage = WshShell.RegRead("HKLM\Software\" & sVirtualDir & "\Language")
  23. If Err.Number <> 0 Then
  24.     DebugLog "Error reading langauge registry key: " & Err.Description
  25.     Err.Clear
  26.     sLanguage = "eng"
  27. End If
  28.     
  29. ' Define translated error messages
  30. Dim sMSG_IIS_NOT_INSTALLED, sMSG_HOW_TO_SETUP
  31. sMSG_IIS_NOT_INSTALLED  = "The Microsoft IIS web server is not installed on this machine."
  32. sMSG_HOW_TO_SETUP       = "If you would like to use the Web Tools, please follow the setup instructions in the user guide."
  33.  
  34. If sLanguage = "deu" Then
  35.     sMSG_IIS_NOT_INSTALLED  = "Microsoft Internet Information Services (IIS) sind auf diesem Computer nicht installiert."
  36.     sMSG_HOW_TO_SETUP       = "Wenn Sie die Web Tools einsetzen m÷chten, lesen Sie die Instruktionen im Benutzerhandbuch."
  37. End If
  38.  
  39.  
  40. DebugLog "Get handle to IIS service"
  41. Dim oWebSvc
  42. Set oWebSvc = GetObject("IIS://" & sComputer & "/W3SVC")
  43. If Err.Number <> 0 Then
  44.     ErrorExit sMSG_IIS_NOT_INSTALLED
  45. End If
  46.  
  47.  
  48. Dim oRoot
  49. DebugLog "Get handle to root of default website"
  50. Set oRoot = GetObject("IIS://" & sComputer & "/W3SVC/1/Root")
  51. If Err.Number <> 0 Then
  52.     ErrorExit "Unable to connect to configure the default web site."
  53. End If
  54.  
  55.  
  56. Dim oVDir
  57. DebugLog "Check if virtual directory already exists"
  58. Set oVDir = GetObject("IIS://" & sComputer & "/W3SVC/1/Root/" & sVirtualDir)
  59. If Err.Number = 0 Then
  60.     ' The virtual dir already exists
  61.     DebugLog "Virtual directory '" & sVirtualDir & "' already exists."
  62.     WScript.Quit 0
  63. End If
  64. Err.Clear
  65. Set oVDir = Nothing
  66.  
  67. DebugLog "Create new virtual directory"
  68. Set oVDir = oRoot.Create("IIsWebVirtualDir", sVirtualDir)
  69. If Err.Number <> 0 Then
  70.     DebugLog Err.Number & " - " & Err.Description
  71.     ErrorExit "Unable to create the Web Tools virtual directory."
  72. End If
  73.  
  74. oVDir.AccessRead = true
  75. oVDir.Path = sPath
  76. If Err.Number <> 0 Then
  77.     ErrorExit "Unable to set virtual directory path: " & sPath & "."
  78. End If
  79.  
  80. ' Save the info
  81. oVDir.SetInfo
  82. If Err.Number <> 0 Then
  83.     ErrorExit "Unable to save changes to IIS virtual directory."
  84. End If
  85.  
  86. ' Create the application
  87. oVDir.AppCreate2(2) ' (0=Low, 1=High, 2=Medium)
  88. If Err.Number <> 0 Then
  89.     ErrorExit "Unable to create web application."
  90. End If
  91.  
  92. oVDir.AppFriendlyName = sVirtualDir
  93. ' Allow scripts to run
  94. oVDir.AccessScript = true
  95. oVDir.SetInfo
  96. If Err.Number <> 0 Then
  97.     ErrorExit "Unable to save changes to IIS application."
  98. End If
  99.  
  100. ' Setup virtual directory settings.  Some of these are defaults, but we set them anyway because they are modified by 
  101. ' some software (e.g. the lock-down tool).
  102. DebugLog "Setup virtual directory settings"
  103.  
  104. ' Disable anonymous access
  105. SetIISSetting sComputer, "W3SVC/1/Root/" & sVirtualDir, "AuthFlags", "4"
  106.  
  107. ' Enable session state
  108. SetIISSetting sComputer, "W3SVC/1/Root/" & sVirtualDir, "AspAllowSessionState", "True"
  109.  
  110. ' Enable parent paths
  111. SetIISSetting sComputer, "W3SVC/1/Root/" & sVirtualDir, "AspEnableParentPaths", "True"
  112.  
  113. ' Set ASP buffering on
  114. SetIISSetting sComputer, "W3SVC/1/Root/" & sVirtualDir, "AspBufferingOn", "True"
  115.  
  116. ' Successfully installed
  117. WScript.Quit 0
  118.  
  119.  
  120.  
  121. ' Displays a message to the user then exits with error code.
  122. Sub ErrorExit(sMsg)
  123.     On Error Resume Next
  124.     Dim sFullMsg 
  125.     
  126.     sFullMsg = sMsg & vbCrLf & vbCrLf & sMSG_HOW_TO_SETUP
  127.     
  128.     WScript.Echo sFullMsg
  129.     WScript.Quit 1
  130. End Sub
  131.  
  132. Sub DebugLog(sMsg)
  133.     'WScript.Echo sMsg
  134. End Sub
  135.  
  136. ' Adapted from adsutil.vbs
  137. Function SetIISSetting(sMachine, sRootPath, sSetting, vValue)
  138.     'On Error Resume Next
  139.     Dim sFullPath
  140.     sFullPath = "IIS://" & sMachine & "/" & sRootPath
  141.     
  142.     Dim oIISPath
  143.     Set oIISPath = GetObject(sFullPath)
  144.     DebugLog "Getting path: " & sFullPath
  145.     If Err.Number <> 0 Then
  146.         ErrorExit "Unable to get IIS path '" & sRootPath & "'"
  147.     End If
  148.     
  149.     Dim oSchema 
  150.     Set oSchema = GetObject("IIS://" & sMachine & "/Schema/" & sSetting)
  151.     If Err.Number <> 0 Then
  152.         ErrorExit "Unable to get schema for property '" & sSetting & "'"
  153.     End If
  154.     
  155.     Dim sDataType
  156.     sDataType = Trim(UCase(oSchema.Syntax))
  157.     DebugLog "Data type: " & sDataType
  158.     
  159.     Select Case (sDataType)
  160.  
  161.         Case "STRING"
  162.             DebugLog "Set string: " & sSetting & " = " & vValue
  163.             oIISPath.Put sSetting, vValue
  164.     
  165.         Case "EXPANDSZ"
  166.             DebugLog "Set expandsz " & sSetting & " = " & vValue
  167.             oIISPath.Put sSetting, vValue
  168.     
  169.         Case "INTEGER"
  170.             DebugLog "Set integer " & sSetting & " = " & vValue
  171.             ' Added to convert hex values to integers
  172.  
  173.             If (UCase(Left(vValue, 2))) = "0X" Then
  174.                 ValueData = "&h" & Right(vValue, Len(vValue) - 2)
  175.             End If
  176.  
  177.             vValue = CLng(vValue)
  178.             oIISPath.Put sSetting, vValue
  179.     
  180.         Case "BOOLEAN"
  181.             DebugLog "Set boolean " & sSetting & " = " & vValue
  182.             vValue = CBool(vValue)
  183.             oIISPath.Put sSetting, vValue
  184.     
  185.         Case "LIST"
  186.             ' Not implemented
  187.             DebugLog "Setting value not supported for datatype: " & oSchema.Syntax
  188.     
  189.         Case Else
  190.             DebugLog "Unknown data type in schema: " & oSchema.Syntax
  191.  
  192.     End Select
  193.     
  194.     ' Save the setting
  195.     oIISPath.Setinfo
  196.     If Err.Number <> 0 Then
  197.         ErrorExit "Unable to save setting: " & sSetting
  198.     End If
  199.     
  200. End Function
  201.  
  202.